home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Membar / Mem.p
Encoding:
Text File  |  1997-05-06  |  3.8 KB  |  156 lines
  1. Program MemBar;
  2.  
  3. { Graphische Speicheranzeige auf der Workbench }
  4. { PUBLIC DOMAIN - 1995 Andreas Tetzl }
  5. { EMail: A.Tetzl@saxonia.de }
  6.  
  7. { Beenden: CTRL c
  8.            Klick mit linker Maustaste auf Balken, Doppelklick
  9.            mit rechter Maustaste
  10. }
  11.  
  12.  
  13. { /// ------------------------------ "Includes" ------------------------------ }
  14.  
  15. {$I "Include:Exec/Libraries.i"}
  16. {$I "Include:Exec/Memory.i"}
  17. {$I "Include:Intuition/Intuition.i"}
  18. {$I "Include:Intuition/Screens.i"}
  19. {$I "Include:Graphics/Graphics.i"}
  20. {$I "Include:Graphics/Pens.i"}
  21. {$I "Include:Utility/Utility.i"}
  22. {$I "Include:DOS/DOS.i"}
  23. {$I "Include:Utils/TagUtils.i"}
  24. {$I "Include:Utils/Break.i"}
  25.  
  26. { /// ------------------------------------------------------------------------ }
  27.  
  28. { /// -------------------------------- "VAR" --------------------------------- }
  29.  
  30. const
  31.     StdInName = NIL;
  32.     StdOutName = NIL;
  33.  
  34.     BACKCOL = 2;
  35.     FULLCOL = 3;
  36.     EMPTYCOL = 0;
  37.     BARWIDTH = 150;
  38.  
  39.     version = "$VER: MemBar v1.0 (5.7.95)";
  40.  
  41. VAR Win : WindowPtr;
  42.     Scr : ScreenPtr;
  43.     TagList : Address;
  44.     RP : RastPortPtr;
  45.     mem, oldmem, total, i : Integer;
  46.  
  47.     s, m : Integer;
  48.     Msg : IntuiMessagePtr;
  49.  
  50.  
  51. { /// ------------------------------------------------------------------------ }
  52.  
  53. { /// --------------------------- "PROCEDURE Req" ---------------------------- }
  54.  
  55. PROCEDURE Req(Txt : String);
  56. const
  57.     es : EasyStruct = (0,0,NIL,NIL,NIL);
  58.  
  59. VAR i : Integer;
  60.  
  61. begin
  62.  es.es_StructSize:=SizeOf(EasyStruct);
  63.  es.es_Flags:=0;
  64.  es.es_Title:="Information";
  65.  es.es_TextFormat:=Txt;
  66.  es.es_GadgetFormat:="OK";
  67.  
  68.  i:=EasyRequestArgs(NIL,adr(es),0,NIL);
  69. END;
  70.  
  71. { /// ------------------------------------------------------------------------ }
  72.  
  73. { /// ------------------------ "PROCEDURE CleanExit" ------------------------- }
  74.  
  75. PROCEDURE CleanExit(Why : String; RC : Integer);
  76. BEGIN
  77.  If Win<>NIL then CloseWindow(Win);
  78.  If GfxBase<>NIL then CloseLibrary(GfxBase);
  79.  If UtilityBase<>NIL then CloseLibrary(UtilityBase);
  80.  If Why<>NIL then Req(Why);
  81.  Exit(RC);
  82. END;
  83.  
  84. { /// ------------------------------------------------------------------------ }
  85.  
  86. { /// ------------------------- "PROCEDURE OpenAll" -------------------------- }
  87.  
  88. PROCEDURE OpenAll;
  89. BEGIN
  90.  UtilityBase:=OpenLibrary("utility.library",37);
  91.  If UtilityBase=NIL then CleanExit("CANT OPEN UTILITY",10);
  92.  
  93.  GfxBase:=OpenLibrary("graphics.library",37);
  94.  IF GfxBase=NIL then CleanExit("CANT OPEN GFX",10);
  95.  
  96.  Scr:=LockPubScreen(NIL);
  97.  If Scr=NIL then CleanExit("CANT FIND WB",10);
  98.  
  99.  TagList:=CreateTagList(WA_Left,Scr^.Width-BARWIDTH-26,
  100.                         WA_Top,0,
  101.                         WA_Width,BARWIDTH,
  102.                         WA_Height,Scr^.BarHeight,
  103.                         WA_Borderless,TRUE,
  104.                         WA_IDCMP,IDCMP_MENUPICK,
  105.                         TAG_END);
  106.  Win:=OpenWindowTagList(NIL,TagList);
  107.  FreeTagItems(TagList);
  108.  If Win=NIL then CleanExit("Can't open window",10);
  109.  RP:=Win^.RPort;
  110.  
  111.  SetRast(RP,BACKCOL);
  112.  total:=AvailMem(MEMF_TOTAL);
  113. END;
  114.  
  115. { /// ------------------------------------------------------------------------ }
  116.  
  117. { /// -------------------------------- "Main" -------------------------------- }
  118.  
  119. BEGIN
  120.  OpenAll;
  121.  
  122.  Repeat
  123.    mem:=total-AvailMem(MEMF_CHIP)-AvailMem(MEMF_FAST);
  124.  
  125.    If Abs(mem-oldmem)>1024 then
  126.     BEGIN
  127.      SetAPen(RP,EMPTYCOL);
  128.      RectFill(RP,1,2,Win^.Width-2,Win^.Height-3);
  129.      SetAPen(RP,FULLCOL);
  130.      RectFill(RP,1,2,(Win^.Width-2)*mem/total,Win^.Height-3);
  131.     END;
  132.  
  133.    oldmem:=mem;
  134.    Delay(50);
  135.  
  136.    Msg:=IntuiMessagePtr(GetMsg(Win^.UserPort));
  137.    If Msg<>NIL then
  138.     BEGIN
  139.      If DoubleClick(s,m,Msg^.Seconds,Msg^.Micros) then
  140.       BEGIN
  141.        ReplyMsg(MessagePtr(Msg));
  142.        CleanExit(NIL,0);
  143.       END;
  144.      ReplyMsg(MessagePtr(Msg));
  145.      s:=Msg^.Seconds;
  146.      m:=Msg^.Micros;
  147.     END;
  148.  
  149.  Until CheckBreak;
  150.  
  151.  CleanExit(NIL,0);
  152. END.
  153.  
  154. { /// ------------------------------------------------------------------------ }
  155.  
  156.